home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / getvalues.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-05  |  5.6 KB  |  150 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         getvalues.lsp
  5. ; RCS:          $Header: getvalues.lsp,v 1.3 91/10/05 15:57:54 mayer Exp $
  6. ; Description:  This file should is a random test to see whether the code
  7. ;               in winterp/src-server/w_resources.c has any machine dependencies.
  8. ;               Load this file, and if your stdout beeps and you see messages
  9. ;               about "failed: ..." then please send the output to mayer@hplabs.hp.com
  10. ;
  11. ;        NOTE: the actual graphical result of loading this file is not
  12. ;        pretty. In fact, it's not supposed to be pretty....
  13. ; Author:       Niels Mayer, HPLabs
  14. ; Created:      Tue Jul 31 19:50:20 1990
  15. ; Modified:     Sat Oct  5 15:56:26 1991 (Niels Mayer) mayer@hplnpm
  16. ; Language:     Lisp
  17. ; Package:      N/A
  18. ; Status:       X11r5 contrib tape release
  19. ;
  20. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  21. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  22. ;
  23. ; Permission to use, copy, modify, distribute, and sell this software and its
  24. ; documentation for any purpose is hereby granted without fee, provided that
  25. ; the above copyright notice appear in all copies and that both that
  26. ; copyright notice and this permission notice appear in supporting
  27. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  28. ; used in advertising or publicity pertaining to distribution of the software
  29. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  30. ; makes no representations about the suitability of this software for any
  31. ; purpose.  It is provided "as is" without express or implied warranty.
  32. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33.  
  34. (progn
  35.   (setq top_w
  36.     (send TOP_LEVEL_SHELL_WIDGET_CLASS :new "Winterp: Set/GetValues Test"
  37.           ))
  38.   (setq scr_w
  39.     (send XM_SCROLLED_WINDOW_WIDGET_CLASS :new :managed top_w
  40.           :XMN_SCROLLING_POLICY :AUTOMATIC
  41.           ))
  42.   (setq rc_w
  43.     (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed
  44.           "rc" scr_w
  45.           :XMN_ORIENTATION :VERTICAL
  46.           :XMN_PACKING :PACK_COLUMN
  47.           :XMN_NUM_COLUMNS 2
  48.           :XMN_ENTRY_ALIGNMENT :ALIGNMENT_CENTER
  49.           ))
  50.  
  51.   (setq te_w (send XM_TEXT_WIDGET_CLASS :new :managed :scrolled rc_w
  52.            :XMN_EDIT_MODE :MULTI_LINE_EDIT
  53.            ))
  54.   (setq pb_w (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "pb" rc_w))
  55.   (setq to_w (send XM_TOGGLE_BUTTON_WIDGET_CLASS :new :managed "tog" rc_w))
  56.   (setq pa_w (send XM_PANED_WINDOW_WIDGET_CLASS :new :managed "paned" rc_w))
  57.   (setq te1_w (send XM_TEXT_WIDGET_CLASS :new :managed :scrolled pa_w
  58.             :XMN_EDIT_MODE :MULTI_LINE_EDIT
  59.             ))
  60.   (setq te2_w (send XM_TEXT_WIDGET_CLASS :new :managed :scrolled pa_w
  61.             :XMN_EDIT_MODE :MULTI_LINE_EDIT
  62.             ))
  63.   (setq te3_w (send XM_TEXT_WIDGET_CLASS :new :managed :scrolled pa_w
  64.             :XMN_EDIT_MODE :MULTI_LINE_EDIT
  65.             ))
  66.   (setq te4_w (send XM_TEXT_WIDGET_CLASS :new :managed :scrolled pa_w
  67.             :XMN_EDIT_MODE :MULTI_LINE_EDIT
  68.             ))
  69.   (setq la_w (send XM_LABEL_WIDGET_CLASS :new :managed "label" rc_w))
  70.  
  71.   (setq li_w
  72.     (send XM_LIST_WIDGET_CLASS :new :managed :scrolled rc_w
  73.           :xmn_selection_policy :browse_select
  74.           :xmn_items #("foo" "bar" "baz" "bof" "boof" "frob" "snob" "blog")
  75.           :xmn_item_count 8
  76.           :xmn_visible_item_count 20
  77.           ))
  78.  
  79.   (send top_w :realize)
  80.   )
  81.  
  82. (defun test (w r v)
  83.   (let (result)
  84.     (send w :set_values r v)
  85.     (send w :get_values r 'result)
  86.     (cond
  87.      ((eq v result)
  88.       (format T "success: widget=~A resource=~A value=~A\n" w r v))
  89.      (t
  90.       (format T "\007\007\007failed: widget=~A resource=~A value=~A result=~A\n" w r v result))
  91.      )))
  92.  
  93.  
  94. (test pb_w :XMN_BORDER_WIDTH 6)        ;XmRDimension
  95. (test pb_w :XMN_HIGHLIGHT_THICKNESS 10)    ;XmRShort
  96. (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0))
  97.     (test pb_w :XMN_SHOW_AS_DEFAULT 5)    ;Motif 1.0 -- XmRShort
  98.   (test pb_w :XMN_SHOW_AS_DEFAULT T))    ;Motif 1.1 -- XmRBooleanDimension
  99. (test pb_w :XMN_SHADOW_THICKNESS 6)    ;XmRShort
  100. (test pa_w :XMN_SASH_INDENT -20)    ;XmRPosition
  101. (test rc_w :XMN_NUM_COLUMNS 1)        ;XmRShort
  102. (if (not (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0))) ;don't do this test for Motif 1.0
  103.     (test to_w :XMN_SPACING 100) ;buggy in 1.0 due to misdeclared resource  names in Motif 1.0 (see comments in w_resources.c)
  104.   )
  105. (test rc_w :XMN_SPACING 10)
  106. (test rc_w :XMN_SPACING 10)
  107. (test pa_w :XMN_SPACING 50)
  108.  
  109. (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0))
  110.     (test rc_w :xmn_rcmargin_width 21)    ;Motif 1.0 workaround
  111.   (test rc_w :xmn_margin_width 10)    ;works in 1.1, buggy in 1.0
  112.   )
  113.  
  114. (test la_w :xmn_margin_width 22)
  115.  
  116. (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0))
  117.     (test rc_w :xmn_rcmargin_height 21)  ;Motif 1.0 workaround
  118.   (test rc_w :xmn_margin_height 20)    ;works in 1.1, buggy in 1.0
  119.   )
  120. (test la_w :xmn_margin_height 22)
  121.  
  122. (test rc_w :XMN_ORIENTATION :vertical)
  123. (test rc_w :XMN_PACKING :pack_none)
  124. (test rc_w :XMN_ENTRY_ALIGNMENT :alignment_beginning)
  125. (test rc_w :XMN_PACKING :no_packing)
  126.  
  127. (test li_w :XMN_SELECTION_POLICY :multiple_select)
  128. (test li_w :XMN_SELECTION_POLICY :single_select)
  129. (test li_w :XMN_SELECTION_POLICY :browse_select)
  130. (test li_w :XMN_SELECTION_POLICY :extended_select)
  131.  
  132. (test top_w :xmn_keyboard_focus_policy :explicit)
  133. (test top_w :xmn_keyboard_focus_policy :pointer)
  134.  
  135. ;; XmRBoolean
  136. (test top_w :XMN_OVERRIDE_REDIRECT t)
  137. (test top_w :XMN_OVERRIDE_REDIRECT nil)
  138. (test top_w :XMN_WAIT_FOR_WM nil)
  139. (test top_w :XMN_WAIT_FOR_WM t)
  140. (test top_w :XMN_TRANSIENT t)
  141. (test top_w :XMN_TRANSIENT nil)
  142.  
  143. ;; XmRChar
  144. (test la_w :XMN_MNEMONIC #\a)
  145. (test la_w :XMN_MNEMONIC #\Z)
  146. (test la_w :XMN_MNEMONIC #\ )
  147. (test la_w :XMN_MNEMONIC #\z)
  148. (test la_w :XMN_MNEMONIC #\\)
  149. (test la_w :XMN_MNEMONIC #\l)
  150.